home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / src / variables.cc < prev    next >
Text File  |  1997-05-26  |  41KB  |  1,780 lines
  1. /*
  2.  
  3. Copyright (C) 1996 John W. Eaton
  4.  
  5. This file is part of Octave.
  6.  
  7. Octave is free software; you can redistribute it and/or modify it
  8. under the terms of the GNU General Public License as published by the
  9. Free Software Foundation; either version 2, or (at your option) any
  10. later version.
  11.  
  12. Octave is distributed in the hope that it will be useful, but WITHOUT
  13. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15. for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with Octave; see the file COPYING.  If not, write to the Free
  19. Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  20.  
  21. */
  22.  
  23. /* Modified by Klaus Gebhardt, 1996 */
  24.  
  25. #ifdef HAVE_CONFIG_H
  26. #include <config.h>
  27. #endif
  28.  
  29. #include <cfloat>
  30. #include <cmath>
  31. #include <cstdio>
  32. #include <cstring>
  33.  
  34. #include <string>
  35.  
  36. #include <iostream.h>
  37. #include <strstream.h>
  38.  
  39. #ifdef HAVE_UNISTD_H
  40. #ifdef HAVE_SYS_TYPES_H
  41. #include <sys/types.h>
  42. #endif
  43. #include <unistd.h>
  44. #endif
  45.  
  46. #if defined (USE_READLINE)
  47. #include <readline/readline.h>
  48. #endif
  49.  
  50. #include "file-ops.h"
  51. #include "oct-glob.h"
  52. #include "str-vec.h"
  53.  
  54. #include <defaults.h>
  55. #include "data.h"
  56. #include "defun.h"
  57. #include "dirfns.h"
  58. #include "dynamic-ld.h"
  59. #include "error.h"
  60. #include "file-io.h"
  61. #include "fn-cache.h"
  62. #include "gripes.h"
  63. #include "help.h"
  64. #include "input.h"
  65. #include "lex.h"
  66. #include "load-save.h"
  67. #include "mappers.h"
  68. #include "oct-hist.h"
  69. #include "toplev.h"
  70. #include "pager.h"
  71. #include "parse.h"
  72. #include "symtab.h"
  73. #include "sysdep.h"
  74. #include "pt-const.h"
  75. #include "oct-obj.h"
  76. #include "pt-exp.h"
  77. #include "pt-fcn.h"
  78. #include "pt-fvc.h"
  79. #include "pt-mat.h"
  80. #include "pt-plot.h"
  81. #include "pr-output.h"
  82. #include "syscalls.h"
  83. #include "toplev.h"
  84. #include "unwind-prot.h"
  85. #include "utils.h"
  86. #include "variables.h"
  87. #include <version.h>
  88.  
  89. // Echo commands as they are executed?
  90. //
  91. //   1  ==>  echo commands read from script files
  92. //   2  ==>  echo commands from functions
  93. //   4  ==>  echo commands read from command line
  94. //
  95. // more than one state can be active at once.
  96. int Vecho_executing_commands;
  97.  
  98. // Where history is saved.
  99. static string Vhistory_file;
  100.  
  101. // The number of lines to keep in the history file.
  102. static int Vhistory_size;
  103.  
  104. // Should Octave always check to see if function files have changed
  105. // since they were last compiled?
  106. static bool Vignore_function_time_stamp;
  107.  
  108. // TRUE if we are saving history.
  109. static int Vsaving_history;
  110.  
  111. // Symbol table for symbols at the top level.
  112. symbol_table *top_level_sym_tab = 0;
  113.  
  114. // Symbol table for the current scope.
  115. symbol_table *curr_sym_tab = 0;
  116.  
  117. // Symbol table for global symbols.
  118. symbol_table *global_sym_tab = 0;
  119.  
  120. octave_variable_reference::octave_variable_reference (tree_indirect_ref *i)
  121.   : id (0), indir (i)
  122. {
  123.   if (indir->is_identifier_only ())
  124.     {
  125.       id = indir->ident ();
  126.       indir = 0;
  127.     }
  128. }
  129.  
  130. void
  131. octave_variable_reference::assign (const octave_value& rhs)
  132. {
  133.   if (id)
  134.     id->assign (rhs);
  135.   else if (indir)
  136.     {
  137.       octave_value& ult = indir->reference ();
  138.       ult = rhs;
  139.     }
  140.   else
  141.     panic_impossible ();
  142. }
  143.  
  144. void
  145. octave_variable_reference::assign (const octave_value_list& idx,
  146.                    const octave_value& rhs)
  147. {
  148.   if (id)
  149.     id->assign (idx, rhs);
  150.   else if (indir)
  151.     {
  152.       octave_value& ult = indir->reference ();
  153.       ult.assign (idx, rhs);
  154.     }
  155.   else
  156.     panic_impossible ();
  157. }
  158.  
  159. octave_value
  160. octave_variable_reference::value (void)
  161. {
  162.   octave_value retval;
  163.  
  164.   if (id)
  165.     retval = id->value ();
  166.   else if (indir)
  167.     retval = indir->value ();
  168.   else
  169.     panic_impossible ();
  170.  
  171.   return retval;
  172. }
  173.   
  174. // Initialization.
  175.  
  176. // Create the initial symbol tables and set the current scope at the
  177. // top level.
  178.  
  179. void
  180. initialize_symbol_tables (void)
  181. {
  182.   if (! global_sym_tab)
  183.     global_sym_tab = new symbol_table ();
  184.  
  185.   if (! top_level_sym_tab)
  186.     top_level_sym_tab = new symbol_table ();
  187.  
  188.   curr_sym_tab = top_level_sym_tab;
  189. }
  190.  
  191. // Attributes of variables and functions.
  192.  
  193. // Is this variable a builtin?
  194.  
  195. bool
  196. is_builtin_variable (const string& name)
  197. {
  198.   symbol_record *sr = global_sym_tab->lookup (name, 0, 0);
  199.   return (sr && sr->is_builtin_variable ());
  200. }
  201.  
  202. // Is this a text-style function?
  203.  
  204. bool
  205. is_text_function_name (const string& s)
  206. {
  207.   symbol_record *sr = global_sym_tab->lookup (s);
  208.   return (sr && sr->is_text_function ());
  209. }
  210.  
  211. // Is this a mapper function?
  212.  
  213. bool
  214. is_builtin_function_name (const string& s)
  215. {
  216.   symbol_record *sr = global_sym_tab->lookup (s);
  217.   return (sr && sr->is_builtin_function ());
  218. }
  219.  
  220. // Is this a mapper function?
  221.  
  222. bool
  223. is_mapper_function_name (const string& s)
  224. {
  225.   symbol_record *sr = global_sym_tab->lookup (s);
  226.   return (sr && sr->is_mapper_function ());
  227. }
  228.  
  229. // Is this function globally in this scope?
  230.  
  231. bool
  232. is_globally_visible (const string& name)
  233. {
  234.   symbol_record *sr = curr_sym_tab->lookup (name, 0, 0);
  235.   return (sr && sr->is_linked_to_global ());
  236. }
  237.  
  238. // Is this octave_value a valid function?
  239.  
  240. tree_fvc *
  241. is_valid_function (const octave_value& arg, const string& warn_for, int warn)
  242. {
  243.   tree_fvc *ans = 0;
  244.  
  245.   string fcn_name;
  246.  
  247.   if (arg.is_string ())
  248.     fcn_name = arg.string_value ();
  249.  
  250.   if (fcn_name.empty () || error_state)
  251.     {
  252.       if (warn)
  253.     error ("%s: expecting function name as argument",
  254.            warn_for.c_str ());
  255.       return ans;
  256.     }
  257.  
  258.   symbol_record *sr = 0;
  259.  
  260.   if (! fcn_name.empty ())
  261.     sr = lookup_by_name (fcn_name);
  262.  
  263.   if (sr)
  264.     ans = sr->def ();
  265.  
  266.   if (! sr || ! ans || ! sr->is_function ())
  267.     {
  268.       if (warn)
  269.     error ("%s: the symbol `%s' is not valid as a function",
  270.            warn_for.c_str (), fcn_name.c_str ());
  271.       ans = 0;
  272.     }
  273.  
  274.   return ans;
  275. }
  276.  
  277. DEFUN (is_global, args, ,
  278.   "is_global (X): return 1 if the string X names a global variable\n\
  279. otherwise, return 0.")
  280. {
  281.   octave_value_list retval = 0.0;
  282.  
  283.   int nargin = args.length ();
  284.  
  285.   if (nargin != 1)
  286.     {
  287.       print_usage ("is_global");
  288.       return retval;
  289.     }
  290.  
  291.   string name = args(0).string_value ();
  292.  
  293.   if (error_state)
  294.     {
  295.       error ("is_global: expecting string argument");
  296.       return retval;
  297.     }
  298.  
  299.   symbol_record *sr = curr_sym_tab->lookup (name, 0, 0);
  300.  
  301.   retval = (double) (sr && sr->is_linked_to_global ());
  302.  
  303.   return retval;
  304. }
  305.  
  306. DEFUN (exist, args, ,
  307.   "exist (NAME): check if variable or file exists\n\
  308. \n\
  309. returns:\n\
  310. \n\
  311.    0 : NAME is undefined\n\
  312.    1 : NAME is a variable\n\
  313.    2 : NAME is a function\n\
  314.    3 : NAME is a .oct file in the current LOADPATH\n\
  315.    5 : NAME is a built-in function")
  316. {
  317.   octave_value_list retval;
  318.  
  319.   int nargin = args.length ();
  320.  
  321.   if (nargin != 1)
  322.     {
  323.       print_usage ("exist");
  324.       return retval;
  325.     }
  326.  
  327.   string name = args(0).string_value ();
  328.  
  329.   if (error_state)
  330.     {
  331.       error ("exist: expecting string argument");
  332.       return retval;
  333.     }
  334.  
  335.   string struct_elts;
  336.  
  337.   size_t pos = name.find ('.');
  338.  
  339.   if (pos != NPOS)
  340.     {
  341.       struct_elts = name.substr (pos+1);
  342.       name = name.substr (0, pos);
  343.     }
  344.  
  345.   symbol_record *sr = curr_sym_tab->lookup (name, 0, 0);
  346.   if (! sr)
  347.     sr = global_sym_tab->lookup (name, 0, 0);
  348.  
  349.   retval = 0.0;
  350.  
  351.   if (sr && sr->is_variable () && sr->is_defined ())
  352.     {
  353.       if (struct_elts.empty () || sr->is_map_element (struct_elts))
  354.     retval = 1.0;
  355.     }
  356.   else if (sr && sr->is_builtin_function ())
  357.     {
  358.       retval = 5.0;
  359.     }
  360.   else if (sr && sr->is_user_function ())
  361.     {
  362.       retval = 2.0;
  363.     }
  364.   else
  365.     {
  366.       string path = fcn_file_in_path (name);
  367.  
  368.       if (path.length () > 0)
  369.     {
  370.       retval = 2.0;
  371.     }
  372.       else
  373.     {
  374.       path = oct_file_in_path (name);
  375.  
  376.       if (path.length () > 0)
  377.         {
  378.           retval = 3.0;
  379.         }
  380.       else
  381.         {
  382.           file_stat fs (name);
  383.  
  384.           if (fs && fs.is_reg ())
  385.         retval = 2.0;
  386.         }
  387.     }
  388.     }
  389.  
  390.   return retval;
  391. }
  392.  
  393. // Is there a corresponding function file that is newer than the
  394. // symbol definition?
  395.  
  396. static int
  397. symbol_out_of_date (symbol_record *sr)
  398. {
  399.   if (Vignore_function_time_stamp == 2)
  400.     return 0;
  401.  
  402.   if (sr)
  403.     {
  404.       tree_fvc *ans = sr->def ();
  405.       if (ans)
  406.     {
  407.       string ff = ans->fcn_file_name ();
  408.       if (! ff.empty ()
  409.           && ! (Vignore_function_time_stamp
  410.             && ans->is_system_fcn_file ()))
  411.         {
  412.           time_t tp = ans->time_parsed ();
  413.  
  414.           string fname = fcn_file_in_path (ff);
  415.  
  416.           int status = is_newer (fname, tp);
  417.  
  418.           if (status > 0)
  419.         return 1;
  420.         }
  421.     }
  422.     }
  423.   return 0;
  424. }
  425.  
  426. static int
  427. looks_like_octave_copyright (const string& s)
  428. {
  429.   string t = s.substr (0, 15);
  430.  
  431.   if (t == " Copyright (C) ")
  432.     {
  433.       size_t pos = s.find ('\n');
  434.  
  435.       if (pos != NPOS)
  436.     {
  437.       pos = s.find ('\n', pos + 1);
  438.  
  439.       if (pos != NPOS)
  440.         {
  441.           pos++;
  442.  
  443.           t = s.substr (pos, 29);
  444.  
  445.           if (t == " This file is part of Octave."
  446.           || t == " This program is free softwar")
  447.         return 1;
  448.         }
  449.     }
  450.     }
  451.   return 0;
  452. }
  453.  
  454. // Eat whitespace and comments from FFILE, returning the text of the
  455. // comments read if it doesn't look like a copyright notice.  If
  456. // IN_PARTS, consider each block of comments separately; otherwise,
  457. // grab them all at once.  If UPDATE_POS is TRUE, line and column
  458. // number information is updated.
  459.  
  460. // XXX FIXME XXX -- grab_help_text() in lex.l duplicates some of this
  461. // code!
  462.  
  463. static string
  464. gobble_leading_white_space (FILE *ffile, bool in_parts, bool update_pos)
  465. {
  466.   string help_txt;
  467.  
  468.   bool first_comments_seen = false;
  469.   bool begin_comment = false;
  470.   bool have_help_text = false;
  471.   bool in_comment = false;
  472.   int c;
  473.  
  474.   while ((c = getc (ffile)) != EOF)
  475.     {
  476.       if (update_pos)
  477.     current_input_column++;
  478.  
  479.       if (begin_comment)
  480.     {
  481.       if (c == '%' || c == '#')
  482.         continue;
  483.       else
  484.         begin_comment = false;
  485.     }
  486.  
  487.       if (in_comment)
  488.     {
  489.       if (! have_help_text)
  490.         {
  491.           first_comments_seen = true;
  492.           if (c == '\r')
  493.         {
  494.           int d = getc (ffile);
  495.           if (c != '\n' && c != '\r' && c != '')
  496.             help_txt += (char) '\n';
  497. #if defined (EMX09C)
  498.           fseek (ffile, -1l, SEEK_CUR);
  499. #else
  500.           ungetc (d, ffile);
  501. #endif
  502.         }
  503.           else if (c == '')  help_txt += (char) '\n';
  504.           else                 help_txt += (char) c;
  505.         }
  506.  
  507.       if (c == '\n' || c == '')
  508.         {
  509.           if (update_pos)
  510.         {
  511.           input_line_number++;
  512.           current_input_column = 0;
  513.         }
  514.           in_comment = false;
  515.  
  516.           if (in_parts)
  517.         {
  518.           if ((c = getc (ffile)) != EOF)
  519.             {
  520.               if (update_pos)
  521.             current_input_column--;
  522. #if defined (EMX09C)
  523.               fseek (ffile, -1l, SEEK_CUR);
  524. #else
  525.               ungetc (c, ffile);
  526. #endif
  527.               if (c == '\n' || c == '\r' || c == '')
  528.             break;
  529.             }
  530.           else
  531.             break;
  532.         }
  533.         }
  534.     }
  535.       else
  536.     {
  537.       switch (c)
  538.         {
  539.         case ' ':
  540.         case '\t':
  541.           if (first_comments_seen)
  542.         have_help_text = true;
  543.           break;
  544.  
  545.         case '\r':
  546.           if (first_comments_seen)  have_help_text = true;
  547.           if (update_pos)           current_input_column = 0;
  548.           continue;
  549.  
  550.         case '':
  551.         case '\n':
  552.           if (first_comments_seen)
  553.         have_help_text = true;
  554.           if (update_pos)
  555.         {
  556.           input_line_number++;
  557.           current_input_column = 0;
  558.         }
  559.           continue;
  560.  
  561.         case '%':
  562.         case '#':
  563.           begin_comment = true;
  564.           in_comment = true;
  565.           break;
  566.  
  567.         default:
  568.           if (update_pos)
  569.         current_input_column--;
  570. #if defined (EMX09C)
  571.           fseek (ffile, -1l, SEEK_CUR);
  572. #else
  573.           ungetc (c, ffile);
  574. #endif
  575.           goto done;
  576.         }
  577.     }
  578.     }
  579.  
  580. done:
  581.  
  582.   if (! help_txt.empty ())
  583.     {
  584.       if (looks_like_octave_copyright (help_txt)) 
  585.     help_txt.resize (0);
  586.  
  587.       if (in_parts && help_txt.empty ())
  588.     help_txt = gobble_leading_white_space (ffile, in_parts, update_pos);
  589.     }
  590.  
  591.   return help_txt;
  592. }
  593.  
  594. static int
  595. is_function_file (FILE *ffile)
  596. {
  597.   int status = 0;
  598.  
  599.   long pos = ftell (ffile);
  600.  
  601.   gobble_leading_white_space (ffile, false, false);
  602.  
  603.   char buf [10];
  604.   fgets (buf, 10, ffile);
  605.   int len = strlen (buf);
  606.   if (len > 8 && strncmp (buf, "function", 8) == 0
  607.       && ! (isalnum (buf[8]) || buf[8] == '_'))
  608.     status = 1;
  609.  
  610.   fseek (ffile, pos, SEEK_SET);
  611.  
  612.   return status;
  613. }
  614.  
  615. static void
  616. restore_command_history (void *)
  617. {
  618.   octave_command_history.ignore_entries (! Vsaving_history);
  619. }
  620.  
  621. static void
  622. safe_fclose (void *f)
  623. {
  624.   if (f)
  625.     fclose ((FILE *) f);
  626. }
  627.  
  628. static int
  629. parse_fcn_file (int exec_script, const string& ff)
  630. {
  631.   begin_unwind_frame ("parse_fcn_file");
  632.  
  633.   int script_file_executed = 0;
  634.  
  635.   // Open function file and parse.
  636.  
  637.   int old_reading_fcn_file_state = reading_fcn_file;
  638.  
  639.   unwind_protect_ptr (rl_instream);
  640.   unwind_protect_ptr (ff_instream);
  641.  
  642.   unwind_protect_int (using_readline);
  643.   unwind_protect_int (input_line_number);
  644.   unwind_protect_int (current_input_column);
  645.   unwind_protect_int (reading_fcn_file);
  646.  
  647.   using_readline = 0;
  648.   reading_fcn_file = 1;
  649.   input_line_number = 0;
  650.   current_input_column = 1;
  651.  
  652.   FILE *ffile = get_input_from_file (ff, 0);
  653.  
  654.   add_unwind_protect (safe_fclose, (void *) ffile);
  655.  
  656.   if (ffile)
  657.     {
  658.       // Check to see if this file defines a function or is just a
  659.       // list of commands.
  660.  
  661.       if (is_function_file (ffile))
  662.     {
  663.       // XXX FIXME XXX -- we shouldn't need both the
  664.       // octave_command_history object and the
  665.       // Vsaving_history variable...
  666.       octave_command_history.ignore_entries ();
  667.  
  668.       add_unwind_protect (restore_command_history, 0);
  669.  
  670.       unwind_protect_int (Vecho_executing_commands);
  671.       unwind_protect_int (Vsaving_history);
  672.       unwind_protect_int (reading_fcn_file);
  673.       unwind_protect_int (input_from_command_line_file);
  674.  
  675.       Vecho_executing_commands = ECHO_OFF;
  676.       Vsaving_history = 0;
  677.       reading_fcn_file = 1;
  678.       input_from_command_line_file = 0;
  679.  
  680.       YY_BUFFER_STATE old_buf = current_buffer ();
  681.       YY_BUFFER_STATE new_buf = create_buffer (ffile);
  682.  
  683.       add_unwind_protect (restore_input_buffer, (void *) old_buf);
  684.       add_unwind_protect (delete_input_buffer, (void *) new_buf);
  685.  
  686.       switch_to_buffer (new_buf);
  687.  
  688.       unwind_protect_ptr (curr_sym_tab);
  689.  
  690.       reset_parser ();
  691.  
  692.       help_buf = gobble_leading_white_space (ffile, true, true);
  693.  
  694.       // XXX FIXME XXX -- this should not be necessary.
  695.       gobble_leading_white_space (ffile, false, true);
  696.  
  697.       int status = yyparse ();
  698.  
  699.       if (status != 0)
  700.         {
  701.           error ("parse error while reading function file %s",
  702.              ff.c_str ());
  703.           global_sym_tab->clear (curr_fcn_file_name);
  704.         }
  705.     }
  706.       else if (exec_script)
  707.     {
  708.       // The value of `reading_fcn_file' will be restored to the
  709.       // proper value when we unwind from this frame.
  710.       reading_fcn_file = old_reading_fcn_file_state;
  711.  
  712.       // XXX FIXME XXX -- we shouldn't need both the
  713.       // octave_command_history object and the
  714.       // Vsaving_history variable...
  715.       octave_command_history.ignore_entries ();
  716.  
  717.       add_unwind_protect (restore_command_history, 0);
  718.  
  719.       unwind_protect_int (Vsaving_history);
  720.       unwind_protect_int (reading_script_file);
  721.  
  722.       Vsaving_history = 0;
  723.       reading_script_file = 1;
  724.  
  725.       parse_and_execute (ffile, 1);
  726.  
  727.       script_file_executed = 1;
  728.     }
  729.     }
  730.  
  731.   run_unwind_frame ("parse_fcn_file");
  732.  
  733.   return script_file_executed;
  734. }
  735.  
  736. static bool
  737. load_fcn_from_file (symbol_record *sym_rec, int exec_script)
  738. {
  739.   bool script_file_executed = false;
  740.  
  741.   string nm = sym_rec->name ();
  742.  
  743.   if (load_octave_oct_file (nm))
  744.     {
  745.       force_link_to_function (nm);
  746.     }
  747.   else
  748.     {
  749.       string ff = fcn_file_in_path (nm);
  750.  
  751.       // These are needed by yyparse.
  752.  
  753.       begin_unwind_frame ("load_fcn_from_file");
  754.  
  755.       unwind_protect_str (curr_fcn_file_name);
  756.       unwind_protect_str (curr_fcn_file_full_name);
  757.  
  758.       curr_fcn_file_name = nm;
  759.       curr_fcn_file_full_name = ff;
  760.  
  761.       if (ff.length () > 0)
  762.     script_file_executed = parse_fcn_file (exec_script, ff);
  763.  
  764.       if (! (error_state || script_file_executed))
  765.     force_link_to_function (nm);
  766.  
  767.       run_unwind_frame ("load_fcn_from_file");
  768.     }
  769.  
  770.   return script_file_executed;
  771. }
  772.  
  773. bool
  774. lookup (symbol_record *sym_rec, int exec_script)
  775. {
  776.   bool script_executed = false;
  777.  
  778.   if (! sym_rec->is_linked_to_global ())
  779.     {
  780.       if (sym_rec->is_defined ())
  781.     {
  782.       if (sym_rec->is_function () && symbol_out_of_date (sym_rec))
  783.         script_executed = load_fcn_from_file (sym_rec, exec_script);
  784.     }
  785.       else if (! sym_rec->is_formal_parameter ())
  786.     {
  787.       link_to_builtin_or_function (sym_rec);
  788.  
  789.       if (! sym_rec->is_defined ())
  790.         script_executed = load_fcn_from_file (sym_rec, exec_script);
  791.       else if (sym_rec->is_function () && symbol_out_of_date (sym_rec))
  792.         script_executed = load_fcn_from_file (sym_rec, exec_script);
  793.     }
  794.     }
  795.  
  796.   return script_executed;
  797. }
  798.  
  799. // Get the symbol record for the given name that is visible in the
  800. // current scope.  Reread any function definitions that appear to be
  801. // out of date.  If a function is available in a file but is not
  802. // currently loaded, this will load it and insert the name in the
  803. // current symbol table.
  804.  
  805. symbol_record *
  806. lookup_by_name (const string& nm, int exec_script)
  807. {
  808.   symbol_record *sym_rec = curr_sym_tab->lookup (nm, 1, 0);
  809.  
  810.   lookup (sym_rec, exec_script);
  811.  
  812.   return sym_rec;
  813. }
  814.  
  815. string
  816. get_help_from_file (const string& path)
  817. {
  818.   string retval;
  819.  
  820.   if (! path.empty ())
  821.     {
  822.       FILE *fptr = fopen (path.c_str (), "rb");
  823.  
  824.       if (fptr)
  825.     {
  826.       add_unwind_protect (safe_fclose, (void *) fptr);
  827.  
  828.       retval = gobble_leading_white_space (fptr, true, true);
  829.  
  830.       run_unwind_protect ();
  831.     }
  832.     }
  833.  
  834.   return retval;
  835. }
  836.  
  837. // Variable values.
  838.  
  839. // Look for the given name in the global symbol table.  If it refers
  840. // to a string, return a new copy.  If not, return 0;
  841.  
  842. string
  843. builtin_string_variable (const string& name)
  844. {
  845.   symbol_record *sr = global_sym_tab->lookup (name, 0, 0);
  846.  
  847.   // It is a prorgramming error to look for builtins that aren't.
  848.  
  849.   assert (sr);
  850.  
  851.   string retval;
  852.  
  853.   tree_fvc *defn = sr->def ();
  854.  
  855.   if (defn)
  856.     {
  857.       octave_value val = defn->eval (0);
  858.  
  859.       if (! error_state && val.is_string ())
  860.     retval = val.string_value ();
  861.     }
  862.  
  863.   return retval;
  864. }
  865.  
  866. // Look for the given name in the global symbol table.  If it refers
  867. // to a real scalar, place the value in d and return 1.  Otherwise,
  868. // return 0.
  869.  
  870. int
  871. builtin_real_scalar_variable (const string& name, double& d)
  872. {
  873.   int status = 0;
  874.   symbol_record *sr = global_sym_tab->lookup (name, 0, 0);
  875.  
  876.   // It is a prorgramming error to look for builtins that aren't.
  877.  
  878.   assert (sr);
  879.  
  880.   tree_fvc *defn = sr->def ();
  881.  
  882.   if (defn)
  883.     {
  884.       octave_value val = defn->eval (0);
  885.  
  886.       if (! error_state && val.is_scalar_type ())
  887.     {
  888.       d = val.double_value ();
  889.       status = 1;
  890.     }
  891.     }
  892.  
  893.   return status;
  894. }
  895.  
  896. // Look for the given name in the global symbol table.
  897.  
  898. octave_value
  899. builtin_any_variable (const string& name)
  900. {
  901.   octave_value retval;
  902.  
  903.   symbol_record *sr = global_sym_tab->lookup (name, 0, 0);
  904.  
  905.   // It is a prorgramming error to look for builtins that aren't.
  906.  
  907.   assert (sr);
  908.  
  909.   tree_fvc *defn = sr->def ();
  910.  
  911.   if (defn)
  912.     retval = defn->eval (0);
  913.  
  914.   return retval;
  915. }
  916.  
  917. // Global stuff and links to builtin variables and functions.
  918.  
  919. // Make the definition of the symbol record sr be the same as the
  920. // definition of the global variable of the same name, creating it if
  921. // it doesn't already exist.
  922.  
  923. void
  924. link_to_global_variable (symbol_record *sr)
  925. {
  926.   if (sr->is_linked_to_global ())
  927.     return;
  928.  
  929.   string nm = sr->name ();
  930.  
  931.   symbol_record *gsr = global_sym_tab->lookup (nm, 1, 0);
  932.  
  933.   if (sr->is_formal_parameter ())
  934.     {
  935.       error ("can't make function parameter `%s' global", nm.c_str ());
  936.       return;
  937.     }
  938.  
  939.   // There must be a better way to do this.   XXX FIXME XXX
  940.  
  941.   if (sr->is_variable ())
  942.     {
  943.       // Would be nice not to have this cast.  XXX FIXME XXX
  944.  
  945.       tree_constant *tmp = (tree_constant *) sr->def ();
  946.       if (tmp)
  947.     tmp = new tree_constant (*tmp);
  948.       else
  949.     tmp = new tree_constant ();
  950.       gsr->define (tmp);
  951.     }
  952.   else
  953.     sr->clear ();
  954.  
  955.   // If the global symbol is currently defined as a function, we need
  956.   // to hide it with a variable.
  957.  
  958.   if (gsr->is_function ())
  959.     gsr->define ((tree_constant *) 0);
  960.  
  961.   sr->alias (gsr, 1);
  962.   sr->mark_as_linked_to_global ();
  963. }
  964.  
  965. // Make the definition of the symbol record sr be the same as the
  966. // definition of the builtin variable of the same name.
  967.  
  968. void
  969. link_to_builtin_variable (symbol_record *sr)
  970. {
  971.   symbol_record *tmp_sym = global_sym_tab->lookup (sr->name (), 0, 0);
  972.  
  973.   if (tmp_sym && tmp_sym->is_builtin_variable ())
  974.     sr->alias (tmp_sym);
  975. }
  976.  
  977. // Make the definition of the symbol record sr be the same as the
  978. // definition of the builtin variable or function, or user function of
  979. // the same name, provided that the name has not been used as a formal
  980. // parameter.
  981.  
  982. void
  983. link_to_builtin_or_function (symbol_record *sr)
  984. {
  985.   symbol_record *tmp_sym = global_sym_tab->lookup (sr->name (), 0, 0);
  986.  
  987.   if (tmp_sym
  988.       && (tmp_sym->is_builtin_variable () || tmp_sym->is_function ())
  989.       && ! tmp_sym->is_formal_parameter ())
  990.     sr->alias (tmp_sym);
  991. }
  992.  
  993. // Force a link to a function in the current symbol table.  This is
  994. // used just after defining a function to avoid different behavior
  995. // depending on whether or not the function has been evaluated after
  996. // being defined.
  997. //
  998. // Return without doing anything if there isn't a function with the
  999. // given name defined in the global symbol table.
  1000.  
  1001. void
  1002. force_link_to_function (const string& id_name)
  1003. {
  1004.   symbol_record *gsr = global_sym_tab->lookup (id_name, 1, 0);
  1005.   if (gsr->is_function ())
  1006.     {
  1007.       curr_sym_tab->clear (id_name);
  1008.       symbol_record *csr = curr_sym_tab->lookup (id_name, 1, 0);
  1009.       csr->alias (gsr);
  1010.     }
  1011. }
  1012.  
  1013. // Help stuff.  Shouldn't this go in help.cc?
  1014.  
  1015. // It's not likely that this does the right thing now.  XXX FIXME XXX
  1016.  
  1017. string_vector
  1018. make_name_list (void)
  1019. {
  1020.   int key_len = 0;
  1021.   int glb_len = 0;
  1022.   int top_len = 0;
  1023.   int lcl_len = 0;
  1024.  
  1025.   string_vector key;
  1026.   string_vector glb;
  1027.   string_vector top;
  1028.   string_vector lcl;
  1029.   string_vector ffl;
  1030.  
  1031.   // Each of these functions returns a new vector of pointers to new
  1032.   // strings.
  1033.  
  1034.   key = names (keyword_help (), key_len);
  1035.  
  1036.   glb = global_sym_tab->list (glb_len);
  1037.  
  1038.   top = top_level_sym_tab->list (top_len);
  1039.  
  1040.   if (top_level_sym_tab != curr_sym_tab)
  1041.     lcl = curr_sym_tab->list (lcl_len);
  1042.  
  1043.   ffl = octave_fcn_file_name_cache::list_no_suffix ();
  1044.   int ffl_len = ffl.length ();
  1045.  
  1046.   int total_len = key_len + glb_len + top_len + lcl_len + ffl_len;
  1047.  
  1048.   string_vector list (total_len);
  1049.  
  1050.   // Put all the symbols in one big list.  Only copy pointers, not the
  1051.   // strings they point to, then only delete the original array of
  1052.   // pointers, and not the strings they point to.
  1053.  
  1054.   int j = 0;
  1055.   int i = 0;
  1056.   for (i = 0; i < key_len; i++)
  1057.     list[j++] = key[i];
  1058.  
  1059.   for (i = 0; i < glb_len; i++)
  1060.     list[j++] = glb[i];
  1061.  
  1062.   for (i = 0; i < top_len; i++)
  1063.     list[j++] = top[i];
  1064.  
  1065.   for (i = 0; i < lcl_len; i++)
  1066.     list[j++] = lcl[i];
  1067.  
  1068.   for (i = 0; i < ffl_len; i++)
  1069.     list[j++] = ffl[i];
  1070.  
  1071.   return list;
  1072. }
  1073.  
  1074. // List variable names.
  1075.  
  1076. static void
  1077. print_symbol_info_line (ostream& os, const symbol_record_info& s)
  1078. {
  1079.   os << (s.is_read_only () ? " -" : " w");
  1080.   os << (s.is_eternal () ? "- " : "d ");
  1081. #if 0
  1082.   os << (s.hides_fcn () ? "f" : (s.hides_builtin () ? "F" : "-"));
  1083. #endif
  1084.   os.form ("  %-16s", s.type_name ().c_str ());
  1085.  
  1086.   int nr = s.rows ();
  1087.   int nc = s.columns ();
  1088.  
  1089.   if (nr < 0)
  1090.     os << "      -";
  1091.   else
  1092.     os.form ("%7d", nr);
  1093.  
  1094.   if (nc < 0)
  1095.     os << "      -";
  1096.   else
  1097.     os.form ("%7d", nc);
  1098.  
  1099.   os << "  " << s.name () << "\n";
  1100. }
  1101.  
  1102. static void
  1103. print_long_listing (ostream& os, symbol_record_info *s)
  1104. {
  1105.   if (! s)
  1106.     return;
  1107.  
  1108.   symbol_record_info *ptr = s;
  1109.   while (ptr->is_defined ())
  1110.     {
  1111.       print_symbol_info_line (os, *ptr);
  1112.       ptr++;
  1113.     }
  1114. }
  1115.  
  1116. static int
  1117. maybe_list (const char *header, const string_vector& argv, int argc,
  1118.         ostream& os, int show_verbose, symbol_table
  1119.         *sym_tab, unsigned type, unsigned scope)
  1120. {
  1121.   int count;
  1122.   int status = 0;
  1123.   if (show_verbose)
  1124.     {
  1125.       symbol_record_info *symbols;
  1126.       symbols = sym_tab->long_list (count, argv, argc, 1, type, scope);
  1127.       if (symbols && count > 0)
  1128.     {
  1129.       os << "\n" << header << "\n\n"
  1130.              << "prot  type               rows   cols  name\n"
  1131.              << "====  ====               ====   ====  ====\n";
  1132.  
  1133.       print_long_listing (os, symbols);
  1134.       status = 1;
  1135.     }
  1136.       delete [] symbols;
  1137.     }
  1138.   else
  1139.     {
  1140.       string_vector symbols = sym_tab->list (count, argv, argc, 1,
  1141.                          type, scope);
  1142.       if (symbols.length () > 0 && count > 0)
  1143.     {
  1144.       os << "\n" << header << "\n\n";
  1145.       symbols.list_in_columns (os);
  1146.       status = 1;
  1147.     }
  1148.     }
  1149.   return status;
  1150. }
  1151.  
  1152. DEFUN (document, args, ,
  1153.   "document (NAME, STRING)\n\
  1154. \n\
  1155. Associate a cryptic message with a variable name.")
  1156. {
  1157.   octave_value retval;
  1158.  
  1159.   int nargin = args.length ();
  1160.  
  1161.   if (nargin == 2)
  1162.     {
  1163.       string name = args(0).string_value ();
  1164.  
  1165.       if (! error_state)
  1166.     {
  1167.       string help = args(1).string_value ();
  1168.  
  1169.       if (! error_state)
  1170.         {
  1171.           if (is_builtin_variable (name)
  1172.           || is_text_function_name (name)
  1173.           || is_mapper_function_name (name)
  1174.           || is_builtin_function_name (name))
  1175.         error ("document: can't redefine help for built-in variables and functions");
  1176.           else
  1177.         {
  1178.           symbol_record *sym_rec = curr_sym_tab->lookup (name, 0);
  1179.  
  1180.           if (sym_rec)
  1181.             sym_rec->document (help);
  1182.           else
  1183.             error ("document: no such symbol `%s'", name.c_str ());
  1184.         }
  1185.         }
  1186.     }
  1187.     }
  1188.   else
  1189.     print_usage ("document");
  1190.  
  1191.   return retval;
  1192. }
  1193.  
  1194. // XXX FIXME XXX -- this should take a list of regular expressions
  1195. // naming the variables to look for.
  1196.  
  1197. static octave_value_list
  1198. do_who (int argc, const string_vector& argv)
  1199. {
  1200.   octave_value_list retval;
  1201.  
  1202.   int show_builtins = 0;
  1203.   int show_functions = (curr_sym_tab == top_level_sym_tab);
  1204.   int show_variables = 1;
  1205.   int show_verbose = 0;
  1206.  
  1207.   string my_name = argv[0];
  1208.  
  1209.   if (argc > 1)
  1210.     {
  1211.       show_functions = 0;
  1212.       show_variables = 0;
  1213.     }
  1214.  
  1215.   int i;
  1216.   for (i = 1; i < argc; i++)
  1217.     {
  1218.       if (argv[i] == "-all" || argv[i] == "-a")
  1219.     {
  1220.       show_builtins++;
  1221.       show_functions++;
  1222.       show_variables++;
  1223.     }
  1224.       else if (argv[i] == "-builtins" || argv[i] == "-b")
  1225.     show_builtins++;
  1226.       else if (argv[i] == "-functions" || argv[i] == "-f")
  1227.     show_functions++;
  1228.       else if (argv[i] == "-long" || argv[i] == "-l")
  1229.     show_verbose++;
  1230.       else if (argv[i] == "-variables" || argv[i] == "-v")
  1231.     show_variables++;
  1232.       else if (argv[i][0] == '-')
  1233.     warning ("%s: unrecognized option `%s'", my_name.c_str (),
  1234.          argv[i].c_str ());
  1235.       else
  1236.     break;
  1237.     }
  1238.  
  1239.   int npats = argc - i;
  1240.   string_vector pats (npats);
  1241.   for (int j = 0; j < npats; j++)
  1242.     pats[j] = argv[i+j];
  1243.  
  1244.   // If the user specified -l and nothing else, show variables.  If
  1245.   // evaluating this at the top level, also show functions.
  1246.  
  1247.   if (show_verbose && ! (show_builtins || show_functions || show_variables))
  1248.     {
  1249.       show_functions = (curr_sym_tab == top_level_sym_tab);
  1250.       show_variables = 1;
  1251.     }
  1252.  
  1253.   int pad_after = 0;
  1254.  
  1255.   if (show_builtins)
  1256.     {
  1257.       pad_after += maybe_list ("*** built-in variables:", pats, npats,
  1258.                    octave_stdout, show_verbose, global_sym_tab,
  1259.                    symbol_def::BUILTIN_VARIABLE,
  1260.                    SYMTAB_ALL_SCOPES);
  1261.  
  1262.       pad_after += maybe_list ("*** built-in functions:", pats, npats,
  1263.                    octave_stdout, show_verbose, global_sym_tab,
  1264.                    symbol_def::BUILTIN_FUNCTION,
  1265.                    SYMTAB_ALL_SCOPES);
  1266.     }
  1267.  
  1268.   if (show_functions)
  1269.     {
  1270.       pad_after += maybe_list ("*** currently compiled functions:",
  1271.                    pats, npats, octave_stdout, show_verbose,
  1272.                    global_sym_tab, symbol_def::USER_FUNCTION,
  1273.                    SYMTAB_ALL_SCOPES);
  1274.     }
  1275.  
  1276.   if (show_variables)
  1277.     {
  1278.       pad_after += maybe_list ("*** local user variables:", pats, npats,
  1279.                    octave_stdout, show_verbose, curr_sym_tab,
  1280.                    symbol_def::USER_VARIABLE,
  1281.                    SYMTAB_LOCAL_SCOPE);
  1282.  
  1283.       pad_after += maybe_list ("*** globally visible user variables:",
  1284.                    pats, npats, octave_stdout, show_verbose,
  1285.                    curr_sym_tab, symbol_def::USER_VARIABLE,
  1286.                    SYMTAB_GLOBAL_SCOPE);
  1287.     }
  1288.  
  1289.   if (pad_after)
  1290.     octave_stdout << "\n";
  1291.  
  1292.   return retval;
  1293. }
  1294.  
  1295. DEFUN_TEXT (who, args, ,
  1296.   "who [-all] [-builtins] [-functions] [-long] [-variables]\n\
  1297. \n\
  1298. List currently defined symbol(s).  Options may be shortened to one\n\
  1299. character, but may not be combined.")
  1300. {
  1301.   octave_value_list retval;
  1302.  
  1303.   int argc = args.length () + 1;
  1304.  
  1305.   string_vector argv = args.make_argv ("who");
  1306.  
  1307.   if (error_state)
  1308.     return retval;
  1309.  
  1310.   retval = do_who (argc, argv);
  1311.  
  1312.   return retval;
  1313. }
  1314.  
  1315. DEFUN_TEXT (whos, args, ,
  1316.   "whos [-all] [-builtins] [-functions] [-long] [-variables]\n\
  1317. \n\
  1318. List currently defined symbol(s).  Options may be shortened to one\n\
  1319. character, but may not be combined.")
  1320. {
  1321.   octave_value_list retval;
  1322.  
  1323.   int nargin = args.length ();
  1324.  
  1325.   octave_value_list tmp_args;
  1326.   for (int i = nargin; i > 0; i--)
  1327.     tmp_args(i) = args(i-1);
  1328.   tmp_args(0) = "-long";
  1329.  
  1330.   int argc = tmp_args.length () + 1;
  1331.  
  1332.   string_vector argv = tmp_args.make_argv ("whos");
  1333.  
  1334.   if (error_state)
  1335.     return retval;
  1336.  
  1337.   retval = do_who (argc, argv);
  1338.  
  1339.   return retval;
  1340. }
  1341.  
  1342. // Install variables and functions in the symbol tables.
  1343.  
  1344. void
  1345. install_builtin_mapper (const builtin_mapper_function& mf)
  1346. {
  1347.   symbol_record *sym_rec = global_sym_tab->lookup (mf.name, 1);
  1348.   sym_rec->unprotect ();
  1349.  
  1350.   tree_builtin *def = new tree_builtin (mf, mf.name);
  1351.  
  1352.   sym_rec->define (def);
  1353.  
  1354.   sym_rec->document (mf.help_string);
  1355.   sym_rec->make_eternal ();
  1356.   sym_rec->protect ();
  1357. }
  1358.  
  1359. void
  1360. install_builtin_function (const builtin_function& f)
  1361. {
  1362.   symbol_record *sym_rec = global_sym_tab->lookup (f.name, 1);
  1363.   sym_rec->unprotect ();
  1364.  
  1365.   tree_builtin *def = new tree_builtin (f.fcn, f.name);
  1366.  
  1367.   sym_rec->define (def, f.is_text_fcn);
  1368.  
  1369.   sym_rec->document (f.help_string);
  1370.   sym_rec->make_eternal ();
  1371.   sym_rec->protect ();
  1372. }
  1373.  
  1374. void
  1375. install_builtin_variable (const builtin_variable& v)
  1376. {
  1377.   if (v.install_as_function)
  1378.     install_builtin_variable_as_function (v.name, v.value, v.protect,
  1379.                       v.eternal, v.help_string);
  1380.   else
  1381.     bind_builtin_variable (v.name, v.value, v.protect, v.eternal,
  1382.                v.sv_function, v.help_string);
  1383. }
  1384.  
  1385. void
  1386. install_builtin_variable_as_function (const string& name,
  1387.                       const octave_value& val,
  1388.                       int protect, int eternal,
  1389.                       const string& help)
  1390. {
  1391.   symbol_record *sym_rec = global_sym_tab->lookup (name, 1);
  1392.   sym_rec->unprotect ();
  1393.  
  1394.   string tmp_help = help.empty () ? sym_rec->help () : help;
  1395.  
  1396.   sym_rec->define_as_fcn (val);
  1397.  
  1398.   sym_rec->document (tmp_help);
  1399.  
  1400.   if (protect)
  1401.     sym_rec->protect ();
  1402.  
  1403.   if (eternal)
  1404.     sym_rec->make_eternal ();
  1405. }
  1406.  
  1407. void
  1408. alias_builtin (const string& alias, const string& name)
  1409. {
  1410.   symbol_record *sr_name = global_sym_tab->lookup (name, 0, 0);
  1411.  
  1412.   if (! sr_name)
  1413.     panic ("can't alias to undefined name!");
  1414.  
  1415.   symbol_record *sr_alias = global_sym_tab->lookup (alias, 1, 0);
  1416.  
  1417.   if (sr_alias)
  1418.     sr_alias->alias (sr_name);
  1419.   else
  1420.     panic ("can't find symbol record for builtin function `%s'",
  1421.        alias.c_str ());
  1422. }
  1423.  
  1424. // Defining variables.
  1425.  
  1426. void
  1427. bind_ans (const octave_value& val, int print)
  1428. {
  1429.   static symbol_record *sr = global_sym_tab->lookup ("ans", 1, 0);
  1430.  
  1431.   tree_identifier *ans_id = new tree_identifier (sr);
  1432.   tree_constant *tmp = new tree_constant (val);
  1433.  
  1434.   // XXX FIXME XXX -- making ans_id static, passing its address to
  1435.   // tree_simple_assignment_expression along with a flag to not delete
  1436.   // it seems to create a memory leak.  Hmm.
  1437.  
  1438.   tree_simple_assignment_expression tmp_ass (ans_id, tmp, false, true);
  1439.  
  1440.   tmp_ass.eval (print);
  1441. }
  1442.  
  1443. void
  1444. bind_global_error_variable (void)
  1445. {
  1446.   *error_message_buffer << ends;
  1447.  
  1448.   char *error_text = error_message_buffer->str ();
  1449.  
  1450.   bind_builtin_variable ("__error_text__", error_text, 1);
  1451.  
  1452.   delete [] error_text;
  1453.  
  1454.   delete error_message_buffer;
  1455.  
  1456.   error_message_buffer = 0;
  1457. }
  1458.  
  1459. void
  1460. clear_global_error_variable (void *)
  1461. {
  1462.   delete error_message_buffer;
  1463.   error_message_buffer = 0;
  1464.  
  1465.   bind_builtin_variable ("__error_text__", "", 1);
  1466. }
  1467.  
  1468. // Give a global variable a definition.  This will insert the symbol
  1469. // in the global table if necessary.
  1470.  
  1471. // How is this different than install_builtin_variable?  Are both
  1472. // functions needed?
  1473.  
  1474. void
  1475. bind_builtin_variable (const string& varname, const octave_value& val,
  1476.                int protect, int eternal, sv_Function sv_fcn,
  1477.                const string& help)
  1478. {
  1479.   symbol_record *sr = global_sym_tab->lookup (varname, 1, 0);
  1480.  
  1481.   // It is a programming error for a builtin symbol to be missing.
  1482.   // Besides, we just inserted it, so it must be there.
  1483.  
  1484.   assert (sr);
  1485.  
  1486.   sr->unprotect ();
  1487.  
  1488.   // Must do this before define, since define will call the special
  1489.   // variable function only if it knows about it, and it needs to, so
  1490.   // that user prefs can be properly initialized.
  1491.  
  1492.   if (sv_fcn)
  1493.     sr->set_sv_function (sv_fcn);
  1494.  
  1495.   sr->define_builtin_var (val);
  1496.  
  1497.   if (protect)
  1498.     sr->protect ();
  1499.  
  1500.   if (eternal)
  1501.     sr->make_eternal ();
  1502.  
  1503.   sr->document (help);
  1504. }
  1505.  
  1506. // XXX FIXME XXX -- some of these should do their own checking to be
  1507. // able to provide more meaningful warning or error messages.
  1508.  
  1509. static int
  1510. echo_executing_commands (void)
  1511. {
  1512.   Vecho_executing_commands = check_preference ("echo_executing_commands"); 
  1513.  
  1514.   return 0;
  1515. }
  1516.  
  1517. static int
  1518. history_size (void)
  1519. {
  1520.   double val;
  1521.   if (builtin_real_scalar_variable ("history_size", val)
  1522.       && ! xisnan (val))
  1523.     {
  1524.       int ival = NINT (val);
  1525.       if (ival >= 0 && (double) ival == val)
  1526.     {
  1527.       Vhistory_size = ival;
  1528.       octave_command_history.set_size (ival);
  1529.       return 0;
  1530.     }
  1531.     }
  1532.   gripe_invalid_value_specified ("history_size");
  1533.   return -1;
  1534. }
  1535.  
  1536. static int
  1537. history_file (void)
  1538. {
  1539.   int status = 0;
  1540.  
  1541.   string s = builtin_string_variable ("history_file");
  1542.  
  1543.   if (s.empty ())
  1544.     {
  1545.       gripe_invalid_value_specified ("history_file");
  1546.       status = -1;
  1547.     }
  1548.   else
  1549.     {
  1550.       Vhistory_file = s;
  1551.       octave_command_history.set_file (oct_tilde_expand (s));
  1552.     }
  1553.  
  1554.   return status;
  1555. }
  1556.  
  1557. static int
  1558. ignore_function_time_stamp (void)
  1559. {
  1560.   int pref = 0;
  1561.  
  1562.   string val = builtin_string_variable ("ignore_function_time_stamp");
  1563.  
  1564.   if (! val.empty ())
  1565.     {
  1566.       if (val.compare ("all", 0, 3) == 0)
  1567.     pref = 2;
  1568.       if (val.compare ("system", 0, 6) == 0)
  1569.     pref = 1;
  1570.     }
  1571.  
  1572.   Vignore_function_time_stamp = pref;
  1573.  
  1574.   return 0;
  1575. }
  1576.  
  1577. static int
  1578. saving_history (void)
  1579. {
  1580.   Vsaving_history = check_preference ("saving_history");
  1581.  
  1582.   octave_command_history.ignore_entries (! Vsaving_history);
  1583.  
  1584.   return 0;
  1585. }
  1586.  
  1587. // XXX FIXME XXX -- there still may be better places for some of these
  1588. // to be defined.
  1589.  
  1590. static void
  1591. symbols_of_variables (void)
  1592. {
  1593.   DEFVAR (ans, , 0, 0,
  1594.     "");
  1595.  
  1596.   DEFCONST (argv, , 0, 0,
  1597.     "the command line arguments this program was invoked with");
  1598.  
  1599.   DEFVAR (echo_executing_commands, (double) ECHO_OFF, 0,
  1600.       echo_executing_commands,
  1601.     "echo commands as they are executed");
  1602.  
  1603.   DEFCONST (error_text, "", 0, 0,
  1604.     "the text of error messages that would have been printed in the
  1605. body of the most recent unwind_protect statement or the TRY part of\n\
  1606. the most recent eval() command.  Outside of unwind_protect and\n\
  1607. eval(), or if no error has ocurred within them, the value of\n\
  1608. __error_text__ is guaranteed to be the empty string.");
  1609.  
  1610.   DEFVAR (history_file, default_history_file (), 0, history_file,
  1611.     "name of command history file");
  1612.  
  1613.   double tmp_hist_size = default_history_size ();
  1614.  
  1615.   DEFVAR (history_size, tmp_hist_size, 0, history_size,
  1616.     "number of commands to save in the history list");
  1617.  
  1618.   DEFVAR (ignore_function_time_stamp, "system", 0, ignore_function_time_stamp,
  1619.     "don't check to see if function files have changed since they were\n\
  1620.   last compiled.  Possible values are \"system\" and \"all\"");
  1621.  
  1622.   DEFCONST (program_invocation_name, Vprogram_invocation_name, 0, 0,
  1623.     "the full name of the current program or script, including the\n\
  1624. directory specification");
  1625.  
  1626.   DEFCONST (program_name, Vprogram_name, 0, 0,
  1627.     "the name of the current program or script");
  1628.  
  1629.   DEFVAR (saving_history, 1.0, 0, saving_history,
  1630.     "save command history");
  1631. }
  1632.  
  1633. void
  1634. install_builtin_variables (void)
  1635. {
  1636.   symbols_of_data ();
  1637.   symbols_of_defaults ();
  1638.   symbols_of_dirfns ();
  1639.   symbols_of_error ();
  1640.   symbols_of_file_io ();
  1641.   symbols_of_help ();
  1642.   symbols_of_input ();
  1643.   symbols_of_lex ();
  1644.   symbols_of_load_save ();
  1645.   symbols_of_pager ();
  1646.   symbols_of_parse ();
  1647.   symbols_of_pr_output ();
  1648.   symbols_of_pt_fcn ();
  1649.   symbols_of_pt_mat ();
  1650.   symbols_of_pt_plot ();
  1651.   symbols_of_syscalls ();
  1652.   symbols_of_toplev ();
  1653.   symbols_of_value ();
  1654.   symbols_of_variables ();
  1655. }
  1656.  
  1657. // Deleting names from the symbol tables.
  1658.  
  1659. DEFUN_TEXT (clear, args, ,
  1660.   "clear [-x] [name ...]\n\
  1661. \n\
  1662. Clear symbol(s) matching a list of globbing patterns.\n\
  1663. \n\
  1664. If no arguments are given, clear all user-defined variables and\n\
  1665. functions.\n\
  1666. \n\
  1667. With -x, exclude the named variables")
  1668. {
  1669.   octave_value_list retval;
  1670.  
  1671.   int argc = args.length () + 1;
  1672.  
  1673.   string_vector argv = args.make_argv ("clear");
  1674.  
  1675.   if (error_state)
  1676.     return retval;
  1677.  
  1678.   // Always clear the local table, but don't clear currently compiled
  1679.   // functions unless we are at the top level.  (Allowing that to
  1680.   // happen inside functions would result in pretty odd behavior...)
  1681.  
  1682.   int clear_user_functions = (curr_sym_tab == top_level_sym_tab);
  1683.  
  1684.   if (argc == 1)
  1685.     {
  1686.       curr_sym_tab->clear ();
  1687.       global_sym_tab->clear (clear_user_functions);
  1688.     }
  1689.   else
  1690.     {
  1691.       int exclusive = 0;
  1692.  
  1693.       int idx = 1;
  1694.  
  1695.       if (argc > 1)
  1696.     {
  1697.       if (argv[idx] == "-x")
  1698.         exclusive = 1;
  1699.     }
  1700.  
  1701.       int lcount = 0;
  1702.       int gcount = 0;
  1703.       int fcount = 0;
  1704.  
  1705.       string_vector lvars;
  1706.       string_vector gvars;
  1707.       string_vector fcns;
  1708.  
  1709.       if (argc > 0)
  1710.     {
  1711.       lvars = curr_sym_tab->list (lcount, 0, 0, 0,
  1712.                       SYMTAB_VARIABLES,
  1713.                       SYMTAB_LOCAL_SCOPE);
  1714.  
  1715.       gvars = curr_sym_tab->list (gcount, 0, 0, 0,
  1716.                       SYMTAB_VARIABLES,
  1717.                       SYMTAB_GLOBAL_SCOPE);
  1718.  
  1719.       fcns = global_sym_tab->list (fcount, 0, 0, 0,
  1720.                        symbol_def::USER_FUNCTION,
  1721.                        SYMTAB_ALL_SCOPES);
  1722.     }
  1723.  
  1724.       // XXX FIXME XXX -- this needs to be optimized to avoid the
  1725.       // pattern matching code if the string doesn't contain any
  1726.       // globbing patterns.
  1727.  
  1728.       for (int k = idx; k < argc; k++)
  1729.     {
  1730.       string patstr = argv[k];
  1731.  
  1732.       if (! patstr.empty ())
  1733.         {
  1734.           glob_match pattern (patstr);
  1735.  
  1736.           int i;
  1737.           for (i = 0; i < lcount; i++)
  1738.         {
  1739.           string nm = lvars[i];
  1740.           int match = pattern.match (nm);
  1741.           if ((exclusive && ! match) || (! exclusive && match))
  1742.             curr_sym_tab->clear (nm);
  1743.         }
  1744.  
  1745.           int count;
  1746.           for (i = 0; i < gcount; i++)
  1747.         {
  1748.           string nm = gvars[i];
  1749.           int match = pattern.match (nm);
  1750.           if ((exclusive && ! match) || (! exclusive && match))
  1751.             {
  1752.               count = curr_sym_tab->clear (nm);
  1753.               if (count > 0)
  1754.             global_sym_tab->clear (nm, clear_user_functions);
  1755.             }
  1756.         }
  1757.  
  1758.           for (i = 0; i < fcount; i++)
  1759.         {
  1760.           string nm = fcns[i];
  1761.           int match = pattern.match (nm);
  1762.           if ((exclusive && ! match) || (! exclusive && match))
  1763.             {
  1764.               count = curr_sym_tab->clear (nm);
  1765.               global_sym_tab->clear (nm, clear_user_functions);
  1766.             }
  1767.         }
  1768.         }
  1769.     }
  1770.     }
  1771.  
  1772.   return retval;
  1773. }
  1774.  
  1775. /*
  1776. ;;; Local Variables: ***
  1777. ;;; mode: C++ ***
  1778. ;;; End: ***
  1779. */
  1780.